Before starting, let’s see a basic example first:
2/22/2021
Before starting, let’s see a basic example first:
Leaflet is one of the most popular open-source JavaScript libraries for interactive and dynamic maps, and the R package “leaflet” makes it easy to integrate and control Leaflet maps in R.
You create a Leaflet map with these basic steps:
We are going to construct a dynamic and interactive map to show daily new case and new death of COVID-19 in different states.
In order to build a daily updated R shiny application later, we choosed the data provided by Johns Hopkins Whiting School of Engineering, and the link is https://github.com/CSSEGISandData/COVID-19.
Besides, we also need to download a US states’ shapefile for drawing corresponding polygons from United States Census Bureau.
After data manipulations, we get the dataset shown below:
head(final_data,n=5)
## States new.case new.death ## 1 Alabama 857 2 ## 2 Alaska 0 0 ## 3 American Samoa 0 0 ## 4 Arizona 1804 25 ## 5 Arkansas 284 9
Then, we import the shapfile using readOGR() function in rgdal package:
states.shape<-readOGR("cb_2018_us_state_500k/cb_2018_us_state_500k.shp")
We should align the name and order of the states in dataset with them in the shapefile.
is.element(final_data$States,states.shape$NAME) final_data<-final_data[-c(10,14),] final_data$States<-factor(final_data$States) levels(final_data$States)[38]<-"Commonwealth of the Northern Mariana Islands" levels(final_data$States)[51]<-"United States Virgin Islands" final_data<-final_data[order(match(final_data$States,states.shape$NAME)),]
head(final_data,n=3);states.shape$NAME[1:3]
## States new.case new.death ## 29 Mississippi 390 0 ## 38 North Carolina 2541 30 ## 42 Oklahoma 1036 26
## [1] Mississippi North Carolina Oklahoma ## 56 Levels: Alabama Alaska American Samoa Arizona Arkansas ... Wyoming
Dmap<-leaflet(height = 300, width = 750) %>% #build a leaflet objection addProviderTiles(provider = providers$Stamen.Toner) %>% setView(lng = -96,lat = 37.8,zoom = 3.5) #localize the map Dmap
#create the color pallet
bins<-c(0,10,100,500,2500,5000,10000,15000,Inf)
pal<-colorBin("RdYlBu",domain = c(0,1),bins = bins)
Dmap<-leaflet() %>%
addProviderTiles(provider = providers$Stamen.Toner) %>%
setView(lng = -96,lat = 37.8,zoom = 3.5) %>%
addPolygons(data = states.shape,
weight = 1, #boundary thickness
color = "white", #boundary color
fillOpacity = 0.5, #opacity of polygons
fillColor = pal(final_data$new.case)
) %>%
addLegend(pal=pal,
values = final_data$new.case,
opacity = 0.7,
position = "topright")
Dmap<-leaflet() %>%
addProviderTiles(provider = providers$Stamen.Toner) %>%
setView(lng = -96,lat = 37.8,zoom = 3.5) %>%
addPolygons(data = states.shape,
weight = 1, #boundary thickness
color = "white", #boundary color
fillOpacity = 0.5, #opacity of polygons
fillColor = pal(final_data$new.case),
highlightOptions = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
bringToFront = TRUE
)) %>%
addLegend(pal=pal,
values = final_data$new.case,
opacity = 0.7,
position = "topright")
case.labels<-paste("<p>",final_data$States,"</p>",
"<p>","Daily new case: ",final_data$new.case,"</p>",sep="")
Dmap<-leaflet() %>%
addProviderTiles(provider = providers$Stamen.Toner) %>%
setView(lng = -96,lat = 37.8,zoom = 3.5) %>%
addPolygons(data = states.shape,
weight = 1,
color = "white",
fillOpacity = 0.5,
fillColor = pal(final_data$new.case),
label = lapply(case.labels,HTML),
highlightOptions = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
bringToFront = TRUE
)) %>%
addLegend(pal=pal,
values = final_data$new.case,
opacity = 0.7)
Dmap<-leaflet() %>%
addProviderTiles(provider = providers$Stamen.Toner) %>%
setView(lng = -96,lat = 37.8,zoom = 3.5) %>%
addPolygons(data = states.shape, weight = 1, color = "white", fillOpacity = 0.5,
fillColor = pal(final_data$new.case),
label = lapply(case.labels,HTML),
group = "case",
highlightOptions = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
bringToFront = TRUE
)) %>%
addPolygons(data = states.shape, weight = 1, color = "white", fillOpacity = 0.5,
fillColor = pal(final_data$new.death),
label = lapply(death.labels,HTML),
group = "death",
highlightOptions = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
bringToFront = TRUE
)) %>%
addLayersControl(baseGroups = c("case","death"))